COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	ENTRY
C00007 ENDMK
C⊗;
ENTRY;
BEGIN
REQUIRE "MACROS.SAI[PNT,HE]" SOURCE_FILE;
REQUIRE "RECORD.DEF[PNT,HE]" SOURCE_FILE;

EXTERNAL INTEGER $DSHTAB,$BRCHR;
EXTERNAL PROCEDURE LINKFR(RPTR(FRAME) N,D);	
EXTERNAL RPTR(FRAME) PROCEDURE FR_INSERT (REFERENCE STRING SYMB);
EXTERNAL PROCEDURE UPDATE;

! tree operations:   copycode,copy,copy_tree;

	! copies the subtree rooted at startfr and affixes it to finalfr.
	  Prefix is used to build the names of the new frames;

PROCEDURE PCOPY(RPTR(FRAME) STARTFR,FINALFR; STRING PREFIX);
	BEGIN
	OWN REAL ARRAY FXF[1:5,1:4];INTEGER LINK;RPTR(FRAME)ROOT;
	RPTR(FRAME) RECURSIVE PROCEDURE COPY_TREE(RPTR(FRAME) ND);
		BEGIN
		! copies the structure rooted at ND.  Leaves copy (NND)
		  affixed to DAD[ND];
	 	RPTR(FRAME) NND,KIDS;
		STRING OLDNAME,LEAVE,NEWNAME;
		OLDNAME←FRAME:PNAME[ND];
		! constructs the new name of the frame: if the name of the copied
		  frame contains an underscore, the part before it is substituted
		  by prefix, otherwise prefix is prefixed;
		LEAVE←SCAN(OLDNAME,$DSHTAB,$BRCHR);	
		IF $BRCHR≠0 
	 	   THEN NEWNAME←PREFIX&OLDNAME
		   ELSE NEWNAME←PREFIX&LEAVE;
	 	NND←FR_INSERT(NEWNAME);			! inserts a new frame;
	 	ARRTRAN(FRAME:XF[NND],FRAME:XF[ND]);
	 	FRAME:HOWLINKED[NND]←FRAME:HOWLINKED[ND];
	 	KIDS←FRAME:SON[ND];
		WHILE KIDS≠NULL_RECORD DO
			BEGIN
			LINKFR(COPY_TREE(KIDS),NND);
			KIDS←FRAME:EBRO[KIDS];
			END;
		RETURN(NND);
		END;
	ROOT←COPY_TREE(STARTFR);			! copies the subtree;
	LINKFR(ROOT,FINALFR);				! sets new links;
	IFC #DISPL THENC UPDATE;ENDC
	END;

	! merges the subtrees under startfr as sons of finalfr. Prefix is
	  used to build the names of new frames;

PROCEDURE PMERGE(RPTR(FRAME) STARTFR,FINALFR;STRING PREFIX);
	BEGIN
	RPTR(FRAME)TEMP,BROTHER;
	TEMP←FRAME:SON[STARTFR];
	DO	BEGIN
		BROTHER←FRAME:EBRO[TEMP];
		PCOPY(TEMP,FINALFR,PREFIX);		! copies one subtree;
		TEMP←BROTHER;
		END
	UNTIL TEMP=NULL_RECORD;
	END;

IFC FALSE THENC
	! executes copy or merge operation on frame1 and frame2. Name indicates
	  the required operation(copy/merge);

PROCEDURE COPYCODE(STRING NAME,FRAME1,FRAME2);
	BEGIN
	RPTR(FRAME) FR1,FR2;STRING PREFIX,ANSWER;
	$ALLOW←$ALLOW+1;
	FR1←BELONGS (FRAME1,#FR);			! frame1 must be a frame;
	FR2←BELONGS (FRAME2,#FR);			! frame2 must be a frame;
	! chooses the prefix for the new names: if the name of frame2 contains an
	  underscore takes  the part before it, otherwise takes the first three
	  characters (long names) or all the name and asks for a confirmation;
	ANSWER←FRAME:PNAME[FR2];	
	PREFIX←SCAN(ANSWER,$DSHTAB,$BRCHR);
	IF $BRCHR=0 AND
	   LENGTH(PREFIX)>5 THEN
	   PREFIX←FRAME:PNAME[FR2] [1 FOR 3];
	PRINT("it's OK to prefix to the new names ");
	PREFIX←RECOVER(PREFIX)&"_";
	IFC #KILL THENC $LAST←CPY;ENDC					! changed after if merge;
	IF NAME="COPY" 
	   THEN PCOPY(FR1,FR2,PREFIX)
	   ELSE PMERGE(FR1,FR2,PREFIX);
	$ALLOW←$ALLOW-1;
	$FRLST←NULL;
	IFC #DISPL THENC UPDATE;ENDC
	END;
ENDC
END;